home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / minihelp.001 / minihelp~ / MiniHelp_Runtime.tcl next >
Encoding:
Text File  |  1996-03-29  |  14.0 KB  |  392 lines

  1. ###############################################################
  2. # TkNet - Help Module
  3. # Charlie KEMPSON - charlie@siren.demon.co.uk
  4. # http://public.logica.com/~kempsonc/tknet.htm
  5. # Version 1.1
  6. ###############################################################
  7.  
  8. ###############################################################
  9. #    This program is free software; you can redistribute it 
  10. #    and/or modify it under the terms of the GNU General 
  11. #    Public License as published by the Free Software 
  12. #    Foundation (version 2 of the License).
  13. #
  14. #    This program is distributed in the hope that it will 
  15. #    be useful, but WITHOUT ANY WARRANTY; without even the 
  16. #    implied warranty of MERCHANTABILITY or FITNESS FOR A 
  17. #    PARTICULAR PURPOSE.  See the GNU General Public License 
  18. #    for more details.
  19. #
  20. #    For a copy of the GNU General Public License, write to the 
  21. #    Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
  22. #    MA 02139, USA.
  23. ###############################################################
  24.  
  25. ###############################################################
  26. # Globals for this module
  27. set gb_show_formatted 1
  28.  
  29. # Flags
  30. set gas_history ""
  31.  
  32. # Geometry
  33. set TKNET_HELP_GEOMETRY "+200+200"
  34.  
  35. # Microhelp strings
  36. set gs_help_connect     "Press to connect to the network"
  37. set gs_help_disconnect  "Press to disconnect from the network"
  38. set gs_help_quit        "Press to disconnect from the network and quit TkNet"
  39. set gs_help_mail        "Press to invoke the mail window"
  40. set gs_help_log         "Press to invoke the log window"
  41. set gs_help_deliver     "Press to deliver/retrieve mail and disconnect"
  42. set gs_help_time        "Length of time connected for (DDD/HH:MM:SS)"
  43. set gs_help_through     "Average link throughput (while connected)"
  44. set gs_help_status      "Network connection status (click to toggle)"
  45. set gs_help_mail        "Whether you have new mail"
  46. set gs_help_popup       "Click the right hand mouse button for menu"
  47.  
  48. ###############################################################
  49. # Show the mini-help panel
  50. proc MH_MiniHelp {text} {
  51.  
  52.    # The argument to MH_MiniHelp must be the name of the page
  53.    # as created by MiniHelp.  Th global avariable containing
  54.    # the help text has this name plus a gs_HELPTEXT_ prefix
  55.    # for uniqueness.
  56.  
  57.    # Globals
  58.    global RIDGE_BORDER DEFAULT_PADDING FONT_NORMAL \
  59.       gt_mini_help TKNET_HELP_GEOMETRY gs_help_contents \
  60.       gas_history
  61.    set global_help "gs_HELPTEXT_$text"
  62.    global $global_help
  63.    set local_text [eval subst \$$global_help]
  64.  
  65.    WatchCursor
  66.    # Test for window
  67.    if ![winfo exists .MH_MiniHelp_window] {
  68.    
  69.       # Create the mini-help screen
  70.       set window [toplevel .MH_MiniHelp_window]
  71.       wm title .MH_MiniHelp_window "Help"
  72.       wm transient .MH_MiniHelp_window .
  73.       wm geometry .MH_MiniHelp_window $TKNET_HELP_GEOMETRY
  74.  
  75.       ###########################################################################
  76.       # Create Menu Bar
  77.       frame $window.mbar -relief raised -bd 2
  78.       pack $window.mbar -side top -fill x
  79.  
  80.       # Create the buttons   
  81.       menubutton $window.mbar.file -text File -underline 0 -menu \
  82.          $window.mbar.file.menu
  83.       menubutton $window.mbar.navigate -text Navigate -underline 0 \
  84.          -menu $window.mbar.navigate.menu
  85.       pack $window.mbar.file $window.mbar.navigate \
  86.          -side left
  87.  
  88.       # Create each menu item
  89.       menu $window.mbar.file.menu -tearoff 0
  90.          $window.mbar.file.menu add command -label "Close" \
  91.             -command "destroy $window" -underline 0
  92.       menu $window.mbar.navigate.menu -tearoff 0
  93.          $window.mbar.navigate.menu add command -label "Contents" \
  94.             -command "MH_MiniHelp $gs_help_contents" -underline 0
  95.          $window.mbar.navigate.menu add command -label "History" \
  96.             -command "MH_ShowHelpHistory" -underline 0
  97.          $window.mbar.navigate.menu add separator
  98.          $window.mbar.navigate.menu add command -label "Back" \
  99.             -command MH_NavigateBack -underline 0
  100.  
  101.       # Create the menu
  102.       tk_menuBar $window.mbar $window.mbar.file \
  103.       $window.mbar.navigate
  104.  
  105.       ###############################################################
  106.       # Create the log panel
  107.       frame .MH_MiniHelp_window.fr -borderwidth $RIDGE_BORDER \
  108.          -relief groove
  109.       pack .MH_MiniHelp_window.fr -padx $DEFAULT_PADDING -pady \
  110.          $DEFAULT_PADDING -side top -expand true -fill both
  111.       set gt_mini_help [ScrolledText \
  112.          .MH_MiniHelp_window.fr.help 80 20 0]
  113.       pack .MH_MiniHelp_window.fr.help -side top -anchor w
  114.    
  115.       ###############################################################
  116.       # Create the buttons below the frame
  117.       frame .MH_MiniHelp_window.button_frame -borderwidth $DEFAULT_PADDING
  118.       pack .MH_MiniHelp_window.button_frame -side bottom -fill x
  119.       button .MH_MiniHelp_window.button_frame.close -font $FONT_NORMAL \
  120.           -text Close -command { destroy .MH_MiniHelp_window }
  121.       pack .MH_MiniHelp_window.button_frame.close
  122.  
  123.    }
  124.  
  125.    # Check for minimised state and raise it
  126.    wm deiconify .MH_MiniHelp_window
  127.    raise .MH_MiniHelp_window
  128.    
  129.    # Put the help text in the window
  130.    $gt_mini_help configure -state normal
  131.    $gt_mini_help delete 1.0 end
  132.    $gt_mini_help insert end $local_text
  133.    MH_ParseHelp 1
  134.    $gt_mini_help configure -state disabled -font \
  135.       $FONT_NORMAL
  136.  
  137.    # Add to the history list (removing any other references to
  138.    # the page on the way - there will be at most one given the
  139.    # nature of the check)
  140.    set item [lsearch -exact $gas_history $text]
  141.    if {$item != -1} {set gas_history [lreplace $gas_history $item $item]}
  142.    lappend gas_history $text
  143.  
  144.    NormalCursor
  145. }
  146.  
  147. ###############################################################
  148. # The procedure for finding tags in the help
  149. proc MH_ParseHelp { is_run_time } {
  150.  
  151.    # If the argument is_run_time is True (1), then 
  152.    # the help text should be interpreted as being
  153.    # run-time help text.  Otherwise, it should be 
  154.    # interpreted as being for the Minihelp editor
  155.  
  156.    # Globals
  157.    global gt_mini_help search FONT_BOLD FONT_ITALIC \
  158.       FIXED_FONT TEXT_COLOUR RED GREEN gb_show_formatted
  159.  
  160.    # If show is true, redisplay the text in formatted form.
  161.    # Otherwise, leave unformatted.
  162.    if {$gb_show_formatted == 1} {
  163.       # Now redisplay the text and disable the save button
  164.       $gt_mini_help configure -state normal
  165.    } else {
  166.       # Disable text
  167.       $gt_mini_help configure -state disabled
  168.       return
  169.    }
  170.  
  171.    # Format list
  172.    set format_list [list TITLE BOLD ITALIC FIXED UNDERLINE CENTER \
  173.       LEFT RIGHT]
  174.  
  175.    # Keyworks and formatting
  176.    set TITLE "TITLE"
  177.    set TITLE_FORMAT "-font $FONT_BOLD -underline True -justify center"
  178.    set BOLD  "B"
  179.    set BOLD_FORMAT "-font $FONT_BOLD"
  180.    set ITALIC "I"
  181.    set ITALIC_FORMAT "-font $FONT_ITALIC"
  182.    set FIXED "TT"
  183.    set FIXED_FORMAT "-font $FIXED_FONT"
  184.    set UNDERLINE "U"
  185.    set UNDERLINE_FORMAT "-underline True"
  186.    set CENTER "CENTER"
  187.    set CENTER_FORMAT "-justify center"
  188.    set LEFT "LEFT"
  189.    set LEFT_FORMAT "-justify left"
  190.    set RIGHT "RIGHT"
  191.    set RIGHT_FORMAT "-justify right"
  192.  
  193.    # Loop round the declared types
  194.    foreach type $format_list {
  195.  
  196.       # Start at the beginning
  197.       set location    1.0
  198.       while {$location != ""} {
  199.          set start [eval $gt_mini_help search -nocase "<$$type>" \
  200.             $location end]
  201.          if {$start != ""} {
  202.             set location [eval $gt_mini_help search -nocase </$$type> \
  203.                $start end]
  204.             $gt_mini_help tag add $type $start $location
  205.          } else {set location ""}
  206.       }
  207.       # DO FORMATTING
  208.       set format [eval subst \$${type}_FORMAT]
  209.       eval $gt_mini_help tag configure $type $format
  210.       $gt_mini_help tag raise $type
  211.  
  212.       # Delete codes and format headers
  213.       set start 1.0
  214.       set end 1.0
  215.       while {$start != "" || $end != ""} {
  216.          set start [eval $gt_mini_help search -nocase "<$$type>" \
  217.             $start end]
  218.          if {$start != ""} {
  219.             $gt_mini_help delete $start "$start +1c wordend +1c"}
  220.          set end [eval $gt_mini_help search -nocase "</$$type>" \
  221.             $end end]
  222.          if {$end != ""} {
  223.             $gt_mini_help delete $end "$end +2c wordend +1c"}
  224.       }
  225.    }
  226.  
  227.    # And now for the hyperlinks to other parts of the help text
  228.    # These are refered to in the text as <XREF location>, where
  229.    # location is the name of the next peice of text, e.g.
  230.    # <XREF gs_site_specific_help>Goto Site Specific help</XREF>
  231.  
  232.    # Start at the beginning
  233.    set location    1.0
  234.    while {$location != ""} {
  235.       set start [eval $gt_mini_help search -nocase "<XREF" \
  236.          $location end]
  237.       if {$start != ""} {
  238.          set location [eval $gt_mini_help search -nocase </XREF> \
  239.             $start end]
  240.          # Get the hyperlink location (note that for this to be
  241.          # successful the tag must start within 3 characters of
  242.          # the <XREF tag.
  243.          set hyper [$gt_mini_help get "$start +1c wordend +3c wordstart" \
  244.             "$start +1c wordend +3c wordend"]
  245.          $gt_mini_help tag add $hyper $start $location
  246.          $gt_mini_help tag raise $hyper
  247.          $gt_mini_help tag configure $hyper -foreground \
  248.             $GREEN -font $FONT_BOLD
  249.          $gt_mini_help tag bind $hyper <Enter> \
  250.             "$gt_mini_help tag configure $hyper -foreground $RED"
  251.          $gt_mini_help tag bind $hyper <Leave> \
  252.             "+$gt_mini_help tag configure $hyper -foreground $GREEN"
  253.          if {$is_run_time == 1} {
  254.             $gt_mini_help tag bind $hyper <ButtonPress> "MH_MiniHelp $hyper"
  255.          } else {
  256.             $gt_mini_help tag bind $hyper <ButtonPress> "MH_ShowHyperMenu $hyper"
  257.          }
  258.       } else {set location ""}
  259.    }
  260.  
  261.    # Delete codes and format headers
  262.    set start 1.0
  263.    set end 1.0
  264.    while {$start != "" || $end != ""} {
  265.       set start [eval $gt_mini_help search -nocase "<XREF" \
  266.          $start end]
  267.       if {$start != ""} {
  268.          $gt_mini_help delete $start "$start +1c wordend +3c wordend +1c"}
  269.       set end [eval $gt_mini_help search -nocase "</XREF>" \
  270.          $end end]
  271.       if {$end != ""} {
  272.          $gt_mini_help delete $end "$end +2c wordend +1c"}
  273.    }
  274. }
  275.  
  276. ###############################################################
  277. # The procedure to navigate backwards through the history
  278. proc MH_NavigateBack {} {
  279.  
  280.    # Globals
  281.    global gas_history gs_help_contents
  282.  
  283.    # The list gas_history contains a list of all help pages
  284.    # visited.  Simply extract the second to last page, and
  285.    # delete the last item in the list, then dislpay the 
  286.    # page.
  287.    if {[llength $gas_history] < 2} {
  288.       # Nowhere to return to
  289.       return
  290.    }
  291.    
  292.    # Get the last page
  293.    set help [lindex $gas_history [expr [llength $gas_history] - 2]]
  294.  
  295.    # Delete the two last items (note that one of them is recreated
  296.    # when we call MH_MiniHelp).
  297.    set gas_history [lreplace $gas_history [expr [llength $gas_history] \
  298.       - 2] end]
  299.  
  300.    # And show the help page
  301.    MH_MiniHelp $help
  302. }
  303.  
  304. ###############################################################
  305. # The procedure to navigate backwards through the history
  306. proc MH_ShowHelpHistory {} {
  307.  
  308.    # Globals
  309.    global gas_history gs_help_contents RIDGE_BORDER \
  310.       DEFAULT_PADDING
  311.  
  312.    # Test for window
  313.    # Popup a selection window
  314.    set window .MH_MiniHelp_history
  315.    if [winfo exists $window] {
  316.        # Pop it up!
  317.        wm deiconify $window
  318.        raise $window
  319.        update
  320.        return
  321.    }
  322.  
  323.    # Create the mini-help screen
  324.    toplevel $window
  325.    wm title $window "Help History"
  326.    wm transient $window .
  327.  
  328.    # Create a frame containing a list
  329.    frame $window.sel_fr -borderwidth $RIDGE_BORDER -relief groove
  330.    pack $window.sel_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  331.       -side top -fill x
  332.    set list [ScrolledList $window.list_fr 0 10 browse 0]
  333.    pack forget $window.list_fr
  334.    pack $window.list_fr -side top -fill both -padx $DEFAULT_PADDING \
  335.       -pady $DEFAULT_PADDING -expand true
  336.  
  337.    # Add the help pages title to the list
  338.    foreach item $gas_history {
  339.       # Get the help text title for the page
  340.       set text "Unknown Help Page"
  341.       global $item
  342.       set local_text [eval subst {\$$item}]
  343.       set start [string first "<title>" $local_text]
  344.       if {$start == -1} {set start [string first "<TITLE>" $local_text]}
  345.       set end [string first "</title>" $local_text]
  346.       if {$end == -1} {set end [string first "</TITLE>" $local_text]}
  347.  
  348.       if {$start != -1} {
  349.          set start [expr [string wordend $local_text [expr $start + 1]] +1]
  350.          set end [expr [string wordstart $local_text $end] -1]
  351.          set text [string range $local_text $start $end]
  352.          set text [string trimleft $text]
  353.       } else {
  354.          Info_Dialog . "Error in help text (${item})!  
  355. All pages must begin with a title e.g. 
  356. <title>Contents</title> or
  357. <TITLE>Contents</TITLE>"
  358.       }
  359.       $list insert end $text
  360.    }
  361.  
  362.    # Now for a goto, close and contents button
  363.    set frame [frame $window.button_fr]
  364.    pack $frame -side bottom -fill x
  365.    button $frame.close -text Close -command "destroy $window"
  366.    button $frame.contents -text Contents -command "MH_MiniHelp $gs_help_contents"
  367.    button $frame.goto -text Goto -command "MH_GotoHelp $window $list"
  368.    pack $frame.close $frame.contents $frame.goto -side right \
  369.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  370.  
  371.    # And now centre it on its parent
  372.    Centre_Dialog $window widget .MH_MiniHelp_window
  373. }
  374.  
  375. ###############################################################
  376. # The procedure to goto a specified page from the history
  377. proc MH_GotoHelp { window list } {
  378.  
  379.    # Globals
  380.    global gas_history
  381.  
  382.    set selected [$list curselection]
  383.    if {$selected == ""} {return}
  384.    set text [lindex $gas_history $selected]
  385.    set gas_history [lreplace $gas_history $selected end]
  386.  
  387.    # Show the new page
  388.    MH_MiniHelp $text
  389.    destroy $window
  390. }
  391.  
  392.